home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 008a / perl40_2.zip / CONSARG.C < prev    next >
C/C++ Source or Header  |  1991-11-28  |  30KB  |  1,351 lines
  1. /* $RCSfile: consarg.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:21:16 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    consarg.c,v $
  9.  * Revision 4.0.1.3  91/11/05  16:21:16  lwall
  10.  * patch11: random cleanup
  11.  * patch11: added eval {}
  12.  * patch11: added sort {} LIST
  13.  * patch11: "foo" x -1 dumped core
  14.  * patch11: substr() and vec() weren't allowed in an lvalue list
  15.  *
  16.  * Revision 4.0.1.2  91/06/07  10:33:12  lwall
  17.  * patch4: new copyright notice
  18.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  19.  *
  20.  * Revision 4.0.1.1  91/04/11  17:38:34  lwall
  21.  * patch1: fixed "Bad free" error
  22.  *
  23.  * Revision 4.0  91/03/20  01:06:15  lwall
  24.  * 4.0 baseline.
  25.  *
  26.  */
  27.  
  28.  
  29. #include "EXTERN.h"
  30. #include "perl.h"
  31. static int nothing_in_common();
  32. static int arg_common();
  33. static int spat_common();
  34.  
  35.  
  36. ARG *
  37. make_split(stab,arg,limarg)
  38. register STAB *stab;
  39. register ARG *arg;
  40. ARG *limarg;
  41. {
  42.     register SPAT *spat;
  43.  
  44.  
  45.     if (arg->arg_type != O_MATCH) {
  46.     Newz(201,spat,1,SPAT);
  47.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  48.     curstash->tbl_spatroot = spat;
  49.  
  50.  
  51.     spat->spat_runtime = arg;
  52.     arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  53.     }
  54.     Renew(arg,4,ARG);
  55.     arg->arg_len = 3;
  56.     if (limarg) {
  57.     if (limarg->arg_type == O_ITEM) {
  58.         Copy(limarg+1,arg+3,1,ARG);
  59.         limarg[1].arg_type = A_NULL;
  60.         arg_free(limarg);
  61.     }
  62.     else {
  63.         arg[3].arg_flags = 0;
  64.         arg[3].arg_type = A_EXPR;
  65.         arg[3].arg_ptr.arg_arg = limarg;
  66.     }
  67.     }
  68.     else {
  69.     arg[3].arg_flags = 0;
  70.     arg[3].arg_type = A_NULL;
  71.     arg[3].arg_ptr.arg_arg = Nullarg;
  72.     }
  73.     arg->arg_type = O_SPLIT;
  74.     spat = arg[2].arg_ptr.arg_spat;
  75.     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
  76.     if (spat->spat_short) {    /* exact match can bypass regexec() */
  77.     if (!((spat->spat_flags & SPAT_SCANFIRST) &&
  78.         (spat->spat_flags & SPAT_ALL) )) {
  79.         str_free(spat->spat_short);
  80.         spat->spat_short = Nullstr;
  81.     }
  82.     }
  83.     return arg;
  84. }
  85.  
  86.  
  87. ARG *
  88. mod_match(type,left,pat)
  89. register ARG *left;
  90. register ARG *pat;
  91. {
  92.  
  93.  
  94.     register SPAT *spat;
  95.     register ARG *newarg;
  96.  
  97.  
  98.     if (!pat)
  99.     return Nullarg;
  100.  
  101.  
  102.     if ((pat->arg_type == O_MATCH ||
  103.      pat->arg_type == O_SUBST ||
  104.      pat->arg_type == O_TRANS ||
  105.      pat->arg_type == O_SPLIT
  106.     ) &&
  107.     pat[1].arg_ptr.arg_stab == defstab ) {
  108.     switch (pat->arg_type) {
  109.     case O_MATCH:
  110.         newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
  111.         pat->arg_len,
  112.         left,Nullarg,Nullarg);
  113.         break;
  114.     case O_SUBST:
  115.         newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
  116.         pat->arg_len,
  117.         left,Nullarg,Nullarg));
  118.         break;
  119.     case O_TRANS:
  120.         newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
  121.         pat->arg_len,
  122.         left,Nullarg,Nullarg));
  123.         break;
  124.     case O_SPLIT:
  125.         newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
  126.         pat->arg_len,
  127.         left,Nullarg,Nullarg);
  128.         break;
  129.     }
  130.     if (pat->arg_len >= 2) {
  131.         newarg[2].arg_type = pat[2].arg_type;
  132.         newarg[2].arg_ptr = pat[2].arg_ptr;
  133.         newarg[2].arg_len = pat[2].arg_len;
  134.         newarg[2].arg_flags = pat[2].arg_flags;
  135.         if (pat->arg_len >= 3) {
  136.         newarg[3].arg_type = pat[3].arg_type;
  137.         newarg[3].arg_ptr = pat[3].arg_ptr;
  138.         newarg[3].arg_len = pat[3].arg_len;
  139.         newarg[3].arg_flags = pat[3].arg_flags;
  140.         }
  141.     }
  142.     free_arg(pat);
  143.     }
  144.     else {
  145.     Newz(202,spat,1,SPAT);
  146.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  147.     curstash->tbl_spatroot = spat;
  148.  
  149.  
  150.     spat->spat_runtime = pat;
  151.     newarg = make_op(type,2,left,Nullarg,Nullarg);
  152.     newarg[2].arg_type = A_SPAT | A_DONT;
  153.     newarg[2].arg_ptr.arg_spat = spat;
  154.     }
  155.  
  156.  
  157.     return newarg;
  158. }
  159.  
  160.  
  161. ARG *
  162. make_op(type,newlen,arg1,arg2,arg3)
  163. int type;
  164. int newlen;
  165. ARG *arg1;
  166. ARG *arg2;
  167. ARG *arg3;
  168. {
  169.     register ARG *arg;
  170.     register ARG *chld;
  171.     register unsigned doarg;
  172.     register int i;
  173.     extern ARG *arg4;    /* should be normal arguments, really */
  174.     extern ARG *arg5;
  175.  
  176.  
  177.     arg = op_new(newlen);
  178.     arg->arg_type = type;
  179.     /*SUPPRESS 560*/
  180.     if (chld = arg1) {
  181.     if (chld->arg_type == O_ITEM &&
  182.         (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
  183.          (i == A_LEXPR &&
  184.           (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  185.            chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  186.            chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
  187.     {
  188.         arg[1].arg_type = chld[1].arg_type;
  189.         arg[1].arg_ptr = chld[1].arg_ptr;
  190.         arg[1].arg_flags |= chld[1].arg_flags;
  191.         arg[1].arg_len = chld[1].arg_len;
  192.         free_arg(chld);
  193.     }
  194.     else {
  195.         arg[1].arg_type = A_EXPR;
  196.         arg[1].arg_ptr.arg_arg = chld;
  197.     }
  198.     }
  199.     /*SUPPRESS 560*/
  200.     if (chld = arg2) {
  201.     if (chld->arg_type == O_ITEM &&
  202.         (hoistable[chld[1].arg_type&A_MASK] ||
  203.          (type == O_ASSIGN &&
  204.           ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  205.         ||
  206.            (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
  207.         ||
  208.            (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
  209.           ) ) ) ) {
  210.         arg[2].arg_type = chld[1].arg_type;
  211.         arg[2].arg_ptr = chld[1].arg_ptr;
  212.         arg[2].arg_len = chld[1].arg_len;
  213.         free_arg(chld);
  214.     }
  215.     else {
  216.         arg[2].arg_type = A_EXPR;
  217.         arg[2].arg_ptr.arg_arg = chld;
  218.     }
  219.     }
  220.     /*SUPPRESS 560*/
  221.     if (chld = arg3) {
  222.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  223.         arg[3].arg_type = chld[1].arg_type;
  224.         arg[3].arg_ptr = chld[1].arg_ptr;
  225.         arg[3].arg_len = chld[1].arg_len;
  226.         free_arg(chld);
  227.     }
  228.     else {
  229.         arg[3].arg_type = A_EXPR;
  230.         arg[3].arg_ptr.arg_arg = chld;
  231.     }
  232.     }
  233.     if (newlen >= 4 && (chld = arg4)) {
  234.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  235.         arg[4].arg_type = chld[1].arg_type;
  236.         arg[4].arg_ptr = chld[1].arg_ptr;
  237.         arg[4].arg_len = chld[1].arg_len;
  238.         free_arg(chld);
  239.     }
  240.     else {
  241.         arg[4].arg_type = A_EXPR;
  242.         arg[4].arg_ptr.arg_arg = chld;
  243.     }
  244.     }
  245.     if (newlen >= 5 && (chld = arg5)) {
  246.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  247.         arg[5].arg_type = chld[1].arg_type;
  248.         arg[5].arg_ptr = chld[1].arg_ptr;
  249.         arg[5].arg_len = chld[1].arg_len;
  250.         free_arg(chld);
  251.     }
  252.     else {
  253.         arg[5].arg_type = A_EXPR;
  254.         arg[5].arg_ptr.arg_arg = chld;
  255.     }
  256.     }
  257.     doarg = opargs[type];
  258.     for (i = 1; i <= newlen; ++i) {
  259.     if (!(doarg & 1))
  260.         arg[i].arg_type |= A_DONT;
  261.     if (doarg & 2)
  262.         arg[i].arg_flags |= AF_ARYOK;
  263.     doarg >>= 2;
  264.     }
  265. #ifdef DEBUGGING
  266.     if (debug & 16) {
  267.     fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
  268.     if (arg1)
  269.         fprintf(stderr,",%s=%lx",
  270.         argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
  271.     if (arg2)
  272.         fprintf(stderr,",%s=%lx",
  273.         argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
  274.     if (arg3)
  275.         fprintf(stderr,",%s=%lx",
  276.         argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
  277.     if (newlen >= 4)
  278.         fprintf(stderr,",%s=%lx",
  279.         argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
  280.     if (newlen >= 5)
  281.         fprintf(stderr,",%s=%lx",
  282.         argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
  283.     fprintf(stderr,")\n");
  284.     }
  285. #endif
  286.     arg = evalstatic(arg);    /* see if we can consolidate anything */
  287.     return arg;
  288. }
  289.  
  290.  
  291. ARG *
  292. evalstatic(arg)
  293. register ARG *arg;
  294. {
  295.     static STR *str = Nullstr;
  296.     register STR *s1;
  297.     register STR *s2;
  298.     double value;        /* must not be register */
  299.     register char *tmps;
  300.     int i;
  301.     unsigned long tmplong;
  302.     long tmp2;
  303.     double exp(), log(), sqrt(), modf();
  304.     char *crypt();
  305.     double sin(), cos(), atan2(), pow();
  306.  
  307.  
  308.     if (!arg || !arg->arg_len)
  309.     return arg;
  310.  
  311.  
  312.     if (!str)
  313.     str = Str_new(20,0);
  314.  
  315.  
  316.     if (arg[1].arg_type == A_SINGLE)
  317.     s1 = arg[1].arg_ptr.arg_str;
  318.     else
  319.     s1 = Nullstr;
  320.     if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
  321.     s2 = arg[2].arg_ptr.arg_str;
  322.     else
  323.     s2 = Nullstr;
  324.  
  325.  
  326. #define CHECK1 if (!s1) return arg
  327. #define CHECK2 if (!s2) return arg
  328. #define CHECK12 if (!s1 || !s2) return arg
  329.  
  330.  
  331.     switch (arg->arg_type) {
  332.     default:
  333.     return arg;
  334.     case O_SORT:
  335.     if (arg[1].arg_type == A_CMD)
  336.         arg[1].arg_type |= A_DONT;
  337.     return arg;
  338.     case O_EVAL:
  339.     if (arg[1].arg_type == A_CMD) {
  340.         arg->arg_type = O_TRY;
  341.         arg[1].arg_type |= A_DONT;
  342.         return arg;
  343.     }
  344.     CHECK1;
  345.     arg->arg_type = O_EVALONCE;
  346.     return arg;
  347.     case O_AELEM:
  348.     CHECK2;
  349.     i = (int)str_gnum(s2);
  350.     if (i < 32767 && i >= 0) {
  351.         arg->arg_type = O_ITEM;
  352.         arg->arg_len = 1;
  353.         arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
  354.         arg[1].arg_len = i;
  355.         str_free(s2);
  356.         Renew(arg, 2, ARG);
  357.     }
  358.     return arg;
  359.     case O_CONCAT:
  360.     CHECK12;
  361.     str_sset(str,s1);
  362.     str_scat(str,s2);
  363.     break;
  364.     case O_REPEAT:
  365.     CHECK12;
  366.     i = (int)str_gnum(s2);
  367.     tmps = str_get(s1);
  368.     str_nset(str,"",0);
  369.     if (i > 0) {
  370.         STR_GROW(str, i * s1->str_cur + 1);
  371.         repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
  372.         str->str_cur = i * s1->str_cur;
  373.         str->str_ptr[str->str_cur] = '\0';
  374.     }
  375.     break;
  376.     case O_MULTIPLY:
  377.     CHECK12;
  378.     value = str_gnum(s1);
  379.     str_numset(str,value * str_gnum(s2));
  380.     break;
  381.     case O_DIVIDE:
  382.     CHECK12;
  383.     value = str_gnum(s2);
  384.     if (value == 0.0)
  385.         yyerror("Illegal division by constant zero");
  386.     else
  387. #ifdef SLOPPYDIVIDE
  388.     /* insure that 20./5. == 4. */
  389.     {
  390.         double x;
  391.         int    k;
  392.         x =  str_gnum(s1);
  393.         if ((double)(int)x     == x &&
  394.         (double)(int)value == value &&
  395.         (k = (int)x/(int)value)*(int)value == (int)x) {
  396.         value = k;
  397.         } else {
  398.         value = x/value;
  399.         }
  400.         str_numset(str,value);
  401.     }
  402. #else
  403.     str_numset(str,str_gnum(s1) / value);
  404. #endif
  405.     break;
  406.     case O_MODULO:
  407.     CHECK12;
  408.     tmplong = (unsigned long)str_gnum(s2);
  409.     if (tmplong == 0L) {
  410.         yyerror("Illegal modulus of constant zero");
  411.         return arg;
  412.     }
  413.     tmp2 = (long)str_gnum(s1);
  414. #ifndef lint
  415.     if (tmp2 >= 0)
  416.         str_numset(str,(double)(tmp2 % tmplong));
  417.     else
  418.         str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  419. #else
  420.     tmp2 = tmp2;
  421. #endif
  422.     break;
  423.     case O_ADD:
  424.     CHECK12;
  425.     value = str_gnum(s1);
  426.     str_numset(str,value + str_gnum(s2));
  427.     break;
  428.     case O_SUBTRACT:
  429.     CHECK12;
  430.     value = str_gnum(s1);
  431.     str_numset(str,value - str_gnum(s2));
  432.     break;
  433.     case O_LEFT_SHIFT:
  434.     CHECK12;
  435.     value = str_gnum(s1);
  436.     i = (int)str_gnum(s2);
  437. #ifndef lint
  438.     str_numset(str,(double)(((long)value) << i));
  439. #endif
  440.     break;
  441.     case O_RIGHT_SHIFT:
  442.     CHECK12;
  443.     value = str_gnum(s1);
  444.     i = (int)str_gnum(s2);
  445. #ifndef lint
  446.     str_numset(str,(double)(((long)value) >> i));
  447. #endif
  448.     break;
  449.     case O_LT:
  450.     CHECK12;
  451.     value = str_gnum(s1);
  452.     str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
  453.     break;
  454.     case O_GT:
  455.     CHECK12;
  456.     value = str_gnum(s1);
  457.     str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
  458.     break;
  459.     case O_LE:
  460.     CHECK12;
  461.     value = str_gnum(s1);
  462.     str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
  463.     break;
  464.     case O_GE:
  465.     CHECK12;
  466.     value = str_gnum(s1);
  467.     str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
  468.     break;
  469.     case O_EQ:
  470.     CHECK12;
  471.     if (dowarn) {
  472.         if ((!s1->str_nok && !looks_like_number(s1)) ||
  473.         (!s2->str_nok && !looks_like_number(s2)) )
  474.         warn("Possible use of == on string value");
  475.     }
  476.     value = str_gnum(s1);
  477.     str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
  478.     break;
  479.     case O_NE:
  480.     CHECK12;
  481.     value = str_gnum(s1);
  482.     str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
  483.     break;
  484.     case O_NCMP:
  485.     CHECK12;
  486.     value = str_gnum(s1);
  487.     value -= str_gnum(s2);
  488.     if (value > 0.0)
  489.         value = 1.0;
  490.     else if (value < 0.0)
  491.         value = -1.0;
  492.     str_numset(str,value);
  493.     break;
  494.     case O_BIT_AND:
  495.     CHECK12;
  496.     value = str_gnum(s1);
  497. #ifndef lint
  498.     str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  499. #endif
  500.     break;
  501.     case O_XOR:
  502.     CHECK12;
  503.     value = str_gnum(s1);
  504. #ifndef lint
  505.     str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  506. #endif
  507.     break;
  508.     case O_BIT_OR:
  509.     CHECK12;
  510.     value = str_gnum(s1);
  511. #ifndef lint
  512.     str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  513. #endif
  514.     break;
  515.     case O_AND:
  516.     CHECK12;
  517.     if (str_true(s1))
  518.         str_sset(str,s2);
  519.     else
  520.         str_sset(str,s1);
  521.     break;
  522.     case O_OR:
  523.     CHECK12;
  524.     if (str_true(s1))
  525.         str_sset(str,s1);
  526.     else
  527.         str_sset(str,s2);
  528.     break;
  529.     case O_COND_EXPR:
  530.     CHECK12;
  531.     if ((arg[3].arg_type & A_MASK) != A_SINGLE)
  532.         return arg;
  533.     if (str_true(s1))
  534.         str_sset(str,s2);
  535.     else
  536.         str_sset(str,arg[3].arg_ptr.arg_str);
  537.     str_free(arg[3].arg_ptr.arg_str);
  538.     Renew(arg, 3, ARG);
  539.     break;
  540.     case O_NEGATE:
  541.     CHECK1;
  542.     str_numset(str,(double)(-str_gnum(s1)));
  543.     break;
  544.     case O_NOT:
  545.     CHECK1;
  546. #ifdef NOTNOT
  547.     { char xxx = str_true(s1); str_numset(str,(double)!xxx); }
  548. #else
  549.     str_numset(str,(double)(!str_true(s1)));
  550. #endif
  551.     break;
  552.     case O_COMPLEMENT:
  553.     CHECK1;
  554. #ifndef lint
  555.     str_numset(str,(double)(~U_L(str_gnum(s1))));
  556. #endif
  557.     break;
  558.     case O_SIN:
  559.     CHECK1;
  560.     str_numset(str,sin(str_gnum(s1)));
  561.     break;
  562.     case O_COS:
  563.     CHECK1;
  564.     str_numset(str,cos(str_gnum(s1)));
  565.     break;
  566.     case O_ATAN2:
  567.     CHECK12;
  568.     value = str_gnum(s1);
  569.     str_numset(str,atan2(value, str_gnum(s2)));
  570.     break;
  571.     case O_POW:
  572.     CHECK12;
  573.     value = str_gnum(s1);
  574.     str_numset(str,pow(value, str_gnum(s2)));
  575.     break;
  576.     case O_LENGTH:
  577.     if (arg[1].arg_type == A_STAB) {
  578.         arg->arg_type = O_ITEM;
  579.         arg[1].arg_type = A_LENSTAB;
  580.         return arg;
  581.     }
  582.     CHECK1;
  583.     str_numset(str, (double)str_len(s1));
  584.     break;
  585.     case O_SLT:
  586.     CHECK12;
  587.     str_numset(str,(double)(str_cmp(s1,s2) < 0));
  588.     break;
  589.     case O_SGT:
  590.     CHECK12;
  591.     str_numset(str,(double)(str_cmp(s1,s2) > 0));
  592.     break;
  593.     case O_SLE:
  594.     CHECK12;
  595.     str_numset(str,(double)(str_cmp(s1,s2) <= 0));
  596.     break;
  597.     case O_SGE:
  598.     CHECK12;
  599.     str_numset(str,(double)(str_cmp(s1,s2) >= 0));
  600.     break;
  601.     case O_SEQ:
  602.     CHECK12;
  603.     str_numset(str,(double)(str_eq(s1,s2)));
  604.     break;
  605.     case O_SNE:
  606.     CHECK12;
  607.     str_numset(str,(double)(!str_eq(s1,s2)));
  608.     break;
  609.     case O_SCMP:
  610.     CHECK12;
  611.     str_numset(str,(double)(str_cmp(s1,s2)));
  612.     break;
  613.     case O_CRYPT:
  614.     CHECK12;
  615. #ifdef HAS_CRYPT
  616.     tmps = str_get(s1);
  617.     str_set(str,crypt(tmps,str_get(s2)));
  618. #else
  619.     yyerror(
  620.     "The crypt() function is unimplemented due to excessive paranoia.");
  621. #endif
  622.     break;
  623.     case O_EXP:
  624.     CHECK1;
  625.     str_numset(str,exp(str_gnum(s1)));
  626.     break;
  627.     case O_LOG:
  628.     CHECK1;
  629.     str_numset(str,log(str_gnum(s1)));
  630.     break;
  631.     case O_SQRT:
  632.     CHECK1;
  633.     str_numset(str,sqrt(str_gnum(s1)));
  634.     break;
  635.     case O_INT:
  636.     CHECK1;
  637.     value = str_gnum(s1);
  638.     if (value >= 0.0)
  639.         (void)modf(value,&value);
  640.     else {
  641.         (void)modf(-value,&value);
  642.         value = -value;
  643.     }
  644.     str_numset(str,value);
  645.     break;
  646.     case O_ORD:
  647.     CHECK1;
  648. #ifndef I286
  649.     str_numset(str,(double)(*str_get(s1)));
  650. #else
  651.     {
  652.         int  zapc;
  653.         char *zaps;
  654.  
  655.  
  656.         zaps = str_get(s1);
  657.         zapc = (int) *zaps;
  658.         str_numset(str,(double)(zapc));
  659.     }
  660. #endif
  661.     break;
  662.     }
  663.     arg->arg_type = O_ITEM;    /* note arg1 type is already SINGLE */
  664.     str_free(s1);
  665.     arg[1].arg_ptr.arg_str = str;
  666.     if (s2) {
  667.     str_free(s2);
  668.     arg[2].arg_ptr.arg_str = Nullstr;
  669.     arg[2].arg_type = A_NULL;
  670.     }
  671.     str = Nullstr;
  672.  
  673.  
  674.     return arg;
  675. }
  676.  
  677.  
  678. ARG *
  679. l(arg)
  680. register ARG *arg;
  681. {
  682.     register int i;
  683.     register ARG *arg1;
  684.     register ARG *arg2;
  685.     SPAT *spat;
  686.     int arghog = 0;
  687.  
  688.  
  689.     i = arg[1].arg_type & A_MASK;
  690.  
  691.  
  692.     arg->arg_flags |= AF_COMMON;    /* assume something in common */
  693.                     /* which forces us to copy things */
  694.  
  695.  
  696.     if (i == A_ARYLEN) {
  697.     arg[1].arg_type = A_LARYLEN;
  698.     return arg;
  699.     }
  700.     if (i == A_ARYSTAB) {
  701.     arg[1].arg_type = A_LARYSTAB;
  702.     return arg;
  703.     }
  704.  
  705.  
  706.     /* see if it's an array reference */
  707.  
  708.  
  709.     if (i == A_EXPR || i == A_LEXPR) {
  710.     arg1 = arg[1].arg_ptr.arg_arg;
  711.  
  712.  
  713.     if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
  714.                         /* assign to list */
  715.         if (arg->arg_len > 1) {
  716.         dehoist(arg,2);
  717.         arg2 = arg[2].arg_ptr.arg_arg;
  718.         if (nothing_in_common(arg1,arg2))
  719.             arg->arg_flags &= ~AF_COMMON;
  720.         if (arg->arg_type == O_ASSIGN) {
  721.             if (arg1->arg_flags & AF_LOCAL)
  722.             arg->arg_flags |= AF_LOCAL;
  723.             arg[1].arg_flags |= AF_ARYOK;
  724.             arg[2].arg_flags |= AF_ARYOK;
  725.         }
  726.         }
  727.         else if (arg->arg_type != O_CHOP)
  728.         arg->arg_type = O_ASSIGN;    /* possible local(); */
  729.         for (i = arg1->arg_len; i >= 1; i--) {
  730.         switch (arg1[i].arg_type) {
  731.         case A_STAR: case A_LSTAR:
  732.             arg1[i].arg_type = A_LSTAR;
  733.             break;
  734.         case A_STAB: case A_LVAL:
  735.             arg1[i].arg_type = A_LVAL;
  736.             break;
  737.         case A_ARYLEN: case A_LARYLEN:
  738.             arg1[i].arg_type = A_LARYLEN;
  739.             break;
  740.         case A_ARYSTAB: case A_LARYSTAB:
  741.             arg1[i].arg_type = A_LARYSTAB;
  742.             break;
  743.         case A_EXPR: case A_LEXPR:
  744.             arg1[i].arg_type = A_LEXPR;
  745.             switch(arg1[i].arg_ptr.arg_arg->arg_type) {
  746.             case O_ARRAY: case O_LARRAY:
  747.             arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
  748.             arghog = 1;
  749.             break;
  750.             case O_AELEM: case O_LAELEM:
  751.             arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
  752.             break;
  753.             case O_HASH: case O_LHASH:
  754.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
  755.             arghog = 1;
  756.             break;
  757.             case O_HELEM: case O_LHELEM:
  758.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
  759.             break;
  760.             case O_ASLICE: case O_LASLICE:
  761.             arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
  762.             break;
  763.             case O_HSLICE: case O_LHSLICE:
  764.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
  765.             break;
  766.             case O_SUBSTR: case O_VEC:
  767.             (void)l(arg1[i].arg_ptr.arg_arg);
  768.             Renewc(arg1[i].arg_ptr.arg_arg->arg_ptr.arg_str, 1,
  769.               struct lstring, STR);
  770.                 /* grow string struct to hold an lstring struct */
  771.             break;
  772.             default:
  773.             goto ill_item;
  774.             }
  775.             break;
  776.         default:
  777.           ill_item:
  778.             (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
  779.               argname[arg1[i].arg_type&A_MASK]);
  780.             yyerror(tokenbuf);
  781.         }
  782.         }
  783.         if (arg->arg_len > 1) {
  784.         if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
  785.             arg2[3].arg_type = A_SINGLE;
  786.             arg2[3].arg_ptr.arg_str =
  787.               str_nmake((double)arg1->arg_len + 1); /* limit split len*/
  788.         }
  789.         }
  790.     }
  791.     else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
  792.         if (arg->arg_type == O_DEFINED)
  793.         arg1->arg_type = O_AELEM;
  794.         else
  795.         arg1->arg_type = O_LAELEM;
  796.     else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
  797.         arg1->arg_type = O_LARRAY;
  798.         if (arg->arg_len > 1) {
  799.         dehoist(arg,2);
  800.         arg2 = arg[2].arg_ptr.arg_arg;
  801.         if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
  802.             spat = arg2[2].arg_ptr.arg_spat;
  803.             if (!(spat->spat_flags & SPAT_ONCE) &&
  804.               nothing_in_common(arg1,spat->spat_repl)) {
  805.             spat->spat_repl[1].arg_ptr.arg_stab =
  806.                 arg1[1].arg_ptr.arg_stab;
  807.             arg1[1].arg_ptr.arg_stab = Nullstab;
  808.             spat->spat_flags |= SPAT_ONCE;
  809.             arg_free(arg1);    /* recursive */
  810.             arg[1].arg_ptr.arg_arg = Nullarg;
  811.             free_arg(arg);    /* non-recursive */
  812.             return arg2;    /* split has builtin assign */
  813.             }
  814.         }
  815.         else if (nothing_in_common(arg1,arg2))
  816.             arg->arg_flags &= ~AF_COMMON;
  817.         if (arg->arg_type == O_ASSIGN) {
  818.             arg[1].arg_flags |= AF_ARYOK;
  819.             arg[2].arg_flags |= AF_ARYOK;
  820.         }
  821.         }
  822.         else if (arg->arg_type == O_ASSIGN)
  823.         arg[1].arg_flags |= AF_ARYOK;
  824.     }
  825.     else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
  826.         if (arg->arg_type == O_DEFINED)
  827.         arg1->arg_type = O_HELEM;    /* avoid creating one */
  828.         else
  829.         arg1->arg_type = O_LHELEM;
  830.     else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
  831.         arg1->arg_type = O_LHASH;
  832.         if (arg->arg_len > 1) {
  833.         dehoist(arg,2);
  834.         arg2 = arg[2].arg_ptr.arg_arg;
  835.         if (nothing_in_common(arg1,arg2))
  836.             arg->arg_flags &= ~AF_COMMON;
  837.         if (arg->arg_type == O_ASSIGN) {
  838.             arg[1].arg_flags |= AF_ARYOK;
  839.             arg[2].arg_flags |= AF_ARYOK;
  840.         }
  841.         }
  842.         else if (arg->arg_type == O_ASSIGN)
  843.         arg[1].arg_flags |= AF_ARYOK;
  844.     }
  845.     else if (arg1->arg_type == O_ASLICE) {
  846.         arg1->arg_type = O_LASLICE;
  847.         if (arg->arg_type == O_ASSIGN) {
  848.         dehoist(arg,2);
  849.         arg[1].arg_flags |= AF_ARYOK;
  850.         arg[2].arg_flags |= AF_ARYOK;
  851.         }
  852.     }
  853.     else if (arg1->arg_type == O_HSLICE) {
  854.         arg1->arg_type = O_LHSLICE;
  855.         if (arg->arg_type == O_ASSIGN) {
  856.         dehoist(arg,2);
  857.         arg[1].arg_flags |= AF_ARYOK;
  858.         arg[2].arg_flags |= AF_ARYOK;
  859.         }
  860.     }
  861.     else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
  862.       (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
  863.         arg[1].arg_type |= A_DONT;
  864.     }
  865.     else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
  866.         (void)l(arg1);
  867.         Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
  868.             /* grow string struct to hold an lstring struct */
  869.     }
  870.     else if (arg1->arg_type == O_ASSIGN)
  871.         /*SUPPRESS 530*/
  872.         ;
  873.     else {
  874.         (void)sprintf(tokenbuf,
  875.           "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
  876.         yyerror(tokenbuf);
  877.     }
  878.     arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
  879.     if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
  880.         arg[1].arg_flags |= AF_ARYOK;
  881.         if (arg->arg_len > 1)
  882.         arg[2].arg_flags |= AF_ARYOK;
  883.     }
  884. #ifdef DEBUGGING
  885.     if (debug & 16)
  886.         fprintf(stderr,"lval LEXPR\n");
  887. #endif
  888.     return arg;
  889.     }
  890.     if (i == A_STAR || i == A_LSTAR) {
  891.     arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
  892.     return arg;
  893.     }
  894.  
  895.  
  896.     /* not an array reference, should be a register name */
  897.  
  898.  
  899.     if (i != A_STAB && i != A_LVAL) {
  900.     (void)sprintf(tokenbuf,
  901.       "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
  902.     yyerror(tokenbuf);
  903.     }
  904.     arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
  905. #ifdef DEBUGGING
  906.     if (debug & 16)
  907.     fprintf(stderr,"lval LVAL\n");
  908. #endif
  909.     return arg;
  910. }
  911.  
  912.  
  913. ARG *
  914. fixl(type,arg)
  915. int type;
  916. ARG *arg;
  917. {
  918.     if (type == O_DEFINED || type == O_UNDEF) {
  919.     if (arg->arg_type != O_ITEM)
  920.         arg = hide_ary(arg);
  921.     if (arg->arg_type == O_ITEM) {
  922.         type = arg[1].arg_type & A_MASK;
  923.         if (type == A_EXPR || type == A_LEXPR)
  924.         arg[1].arg_type = A_LEXPR|A_DONT;
  925.     }
  926.     }
  927.     return arg;
  928. }
  929.  
  930.  
  931. dehoist(arg,i)
  932. ARG *arg;
  933. {
  934.     ARG *tmparg;
  935.  
  936.  
  937.     if (arg[i].arg_type != A_EXPR) {    /* dehoist */
  938.     tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
  939.     tmparg[1] = arg[i];
  940.     arg[i].arg_ptr.arg_arg = tmparg;
  941.     arg[i].arg_type = A_EXPR;
  942.     }
  943. }
  944.  
  945.  
  946. ARG *
  947. addflags(i,flags,arg)
  948. register ARG *arg;
  949. {
  950.     arg[i].arg_flags |= flags;
  951.     return arg;
  952. }
  953.  
  954.  
  955. ARG *
  956. hide_ary(arg)
  957. ARG *arg;
  958. {
  959.     if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
  960.     return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
  961.     return arg;
  962. }
  963.  
  964.  
  965. /* maybe do a join on multiple array dimensions */
  966.  
  967.  
  968. ARG *
  969. jmaybe(arg)
  970. register ARG *arg;
  971. {
  972.     if (arg && arg->arg_type == O_COMMA) {
  973.     arg = listish(arg);
  974.     arg = make_op(O_JOIN, 2,
  975.         stab2arg(A_STAB,stabent(";",TRUE)),
  976.         make_list(arg),
  977.         Nullarg);
  978.     }
  979.     return arg;
  980. }
  981.  
  982.  
  983. ARG *
  984. make_list(arg)
  985. register ARG *arg;
  986. {
  987.     register int i;
  988.     register ARG *node;
  989.     register ARG *nxtnode;
  990.     register int j;
  991.     STR *tmpstr;
  992.  
  993.  
  994.     if (!arg) {
  995.     arg = op_new(0);
  996.     arg->arg_type = O_LIST;
  997.     }
  998.     if (arg->arg_type != O_COMMA) {
  999.     if (arg->arg_type != O_ARRAY)
  1000.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  1001.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  1002.     return arg;
  1003.     }
  1004.     for (i = 2, node = arg; ; i++) {
  1005.     if (node->arg_len < 2)
  1006.         break;
  1007.         if (node[1].arg_type != A_EXPR)
  1008.         break;
  1009.     node = node[1].arg_ptr.arg_arg;
  1010.     if (node->arg_type != O_COMMA)
  1011.         break;
  1012.     }
  1013.     if (i > 2) {
  1014.     node = arg;
  1015.     arg = op_new(i);
  1016.     tmpstr = arg->arg_ptr.arg_str;
  1017. #ifdef STRUCTCOPY
  1018.     *arg = *node;        /* copy everything except the STR */
  1019. #else
  1020.     (void)bcopy((char *)node, (char *)arg, sizeof(ARG));
  1021. #endif
  1022.     arg->arg_ptr.arg_str = tmpstr;
  1023.     for (j = i; ; ) {
  1024. #ifdef STRUCTCOPY
  1025.         arg[j] = node[2];
  1026. #else
  1027.         (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
  1028. #endif
  1029.         arg[j].arg_flags |= AF_ARYOK;
  1030.         --j;        /* Bug in Xenix compiler */
  1031.         if (j < 2) {
  1032. #ifdef STRUCTCOPY
  1033.         arg[1] = node[1];
  1034. #else
  1035.         (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
  1036. #endif
  1037.         free_arg(node);
  1038.         break;
  1039.         }
  1040.         nxtnode = node[1].arg_ptr.arg_arg;
  1041.         free_arg(node);
  1042.         node = nxtnode;
  1043.     }
  1044.     }
  1045.     arg[1].arg_flags |= AF_ARYOK;
  1046.     arg[2].arg_flags |= AF_ARYOK;
  1047.     arg->arg_type = O_LIST;
  1048.     arg->arg_len = i;
  1049.     return arg;
  1050. }
  1051.  
  1052.  
  1053. /* turn a single item into a list */
  1054.  
  1055.  
  1056. ARG *
  1057. listish(arg)
  1058. ARG *arg;
  1059. {
  1060.     if (arg && arg->arg_flags & AF_LISTISH)
  1061.     arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
  1062.     return arg;
  1063. }
  1064.  
  1065.  
  1066. ARG *
  1067. maybelistish(optype, arg)
  1068. int optype;
  1069. ARG *arg;
  1070. {
  1071.     ARG *tmparg = arg;
  1072.  
  1073.  
  1074.     if (optype == O_RETURN && arg->arg_type == O_ITEM &&
  1075.       arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
  1076.       ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
  1077.     tmparg = listish(tmparg);
  1078.     free_arg(arg);
  1079.     arg = tmparg;
  1080.     }
  1081.     else if (optype == O_PRTF ||
  1082.       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
  1083.        arg->arg_type == O_F_OR_R) )
  1084.     arg = listish(arg);
  1085.     return arg;
  1086. }
  1087.  
  1088.  
  1089. /* mark list of local variables */
  1090.  
  1091.  
  1092. ARG *
  1093. localize(arg)
  1094. ARG *arg;
  1095. {
  1096.     arg->arg_flags |= AF_LOCAL;
  1097.     return arg;
  1098. }
  1099.  
  1100.  
  1101. ARG *
  1102. rcatmaybe(arg)
  1103. ARG *arg;
  1104. {
  1105.     ARG *arg2;
  1106.  
  1107.  
  1108.     if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
  1109.     arg2 = arg[2].arg_ptr.arg_arg;
  1110.     if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
  1111.         arg->arg_type = O_RCAT;
  1112.         arg[2].arg_type = arg2[1].arg_type;
  1113.         arg[2].arg_ptr = arg2[1].arg_ptr;
  1114.         free_arg(arg2);
  1115.     }
  1116.     }
  1117.     return arg;
  1118. }
  1119.  
  1120.  
  1121. ARG *
  1122. stab2arg(atype,stab)
  1123. int atype;
  1124. register STAB *stab;
  1125. {
  1126.     register ARG *arg;
  1127.  
  1128.  
  1129.     arg = op_new(1);
  1130.     arg->arg_type = O_ITEM;
  1131.     arg[1].arg_type = atype;
  1132.     arg[1].arg_ptr.arg_stab = stab;
  1133.     return arg;
  1134. }
  1135.  
  1136.  
  1137. ARG *
  1138. cval_to_arg(cval)
  1139. register char *cval;
  1140. {
  1141.     register ARG *arg;
  1142.  
  1143.  
  1144.     arg = op_new(1);
  1145.     arg->arg_type = O_ITEM;
  1146.     arg[1].arg_type = A_SINGLE;
  1147.     arg[1].arg_ptr.arg_str = str_make(cval,0);
  1148.     Safefree(cval);
  1149.     return arg;
  1150. }
  1151.  
  1152.  
  1153. ARG *
  1154. op_new(numargs)
  1155. int numargs;
  1156. {
  1157.     register ARG *arg;
  1158.  
  1159.  
  1160.     Newz(203,arg, numargs + 1, ARG);
  1161.     arg->arg_ptr.arg_str = Str_new(21,0);
  1162.     arg->arg_len = numargs;
  1163.     return arg;
  1164. }
  1165.  
  1166.  
  1167. void
  1168. free_arg(arg)
  1169. ARG *arg;
  1170. {
  1171.     str_free(arg->arg_ptr.arg_str);
  1172.     Safefree(arg);
  1173. }
  1174.  
  1175.  
  1176. ARG *
  1177. make_match(type,expr,spat)
  1178. int type;
  1179. ARG *expr;
  1180. SPAT *spat;
  1181. {
  1182.     register ARG *arg;
  1183.  
  1184.  
  1185.     arg = make_op(type,2,expr,Nullarg,Nullarg);
  1186.  
  1187.  
  1188.     arg[2].arg_type = A_SPAT|A_DONT;
  1189.     arg[2].arg_ptr.arg_spat = spat;
  1190. #ifdef DEBUGGING
  1191.     if (debug & 16)
  1192.     fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
  1193. #endif
  1194.  
  1195.  
  1196.     if (type == O_SUBST || type == O_NSUBST) {
  1197.     if (arg[1].arg_type != A_STAB) {
  1198.         yyerror("Illegal lvalue");
  1199.     }
  1200.     arg[1].arg_type = A_LVAL;
  1201.     }
  1202.     return arg;
  1203. }
  1204.  
  1205.  
  1206. ARG *
  1207. cmd_to_arg(cmd)
  1208. CMD *cmd;
  1209. {
  1210.     register ARG *arg;
  1211.  
  1212.  
  1213.     arg = op_new(1);
  1214.     arg->arg_type = O_ITEM;
  1215.     arg[1].arg_type = A_CMD;
  1216.     arg[1].arg_ptr.arg_cmd = cmd;
  1217.     return arg;
  1218. }
  1219.  
  1220.  
  1221. /* Check two expressions to see if there is any identifier in common */
  1222.  
  1223.  
  1224. static int
  1225. nothing_in_common(arg1,arg2)
  1226. ARG *arg1;
  1227. ARG *arg2;
  1228. {
  1229.     static int thisexpr = 0;    /* I don't care if this wraps */
  1230.  
  1231.  
  1232.     thisexpr++;
  1233.     if (arg_common(arg1,thisexpr,1))
  1234.     return 0;    /* hit eval or do {} */
  1235.     stab_lastexpr(defstab) = thisexpr;        /* pretend to hit @_ */
  1236.     if (arg_common(arg2,thisexpr,0))
  1237.     return 0;    /* hit identifier again */
  1238.     return 1;
  1239. }
  1240.  
  1241.  
  1242. /* Recursively descend an expression and mark any identifier or check
  1243.  * it to see if it was marked already.
  1244.  */
  1245.  
  1246.  
  1247. static int
  1248. arg_common(arg,exprnum,marking)
  1249. register ARG *arg;
  1250. int exprnum;
  1251. int marking;
  1252. {
  1253.     register int i;
  1254.  
  1255.  
  1256.     if (!arg)
  1257.     return 0;
  1258.     for (i = arg->arg_len; i >= 1; i--) {
  1259.     switch (arg[i].arg_type & A_MASK) {
  1260.     case A_NULL:
  1261.         break;
  1262.     case A_LEXPR:
  1263.     case A_EXPR:
  1264.         if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
  1265.         return 1;
  1266.         break;
  1267.     case A_CMD:
  1268.         return 1;        /* assume hanky panky */
  1269.     case A_STAR:
  1270.     case A_LSTAR:
  1271.     case A_STAB:
  1272.     case A_LVAL:
  1273.     case A_ARYLEN:
  1274.     case A_LARYLEN:
  1275.         if (marking)
  1276.         stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
  1277.         else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
  1278.         return 1;
  1279.         break;
  1280.     case A_DOUBLE:
  1281.     case A_BACKTICK:
  1282.         {
  1283.         register char *s = arg[i].arg_ptr.arg_str->str_ptr;
  1284.         register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
  1285.         register STAB *stab;
  1286.  
  1287.  
  1288.         while (*s) {
  1289.             if (*s == '$' && s[1]) {
  1290.             s = scanident(s,send,tokenbuf);
  1291.             stab = stabent(tokenbuf,TRUE);
  1292.             if (marking)
  1293.                 stab_lastexpr(stab) = exprnum;
  1294.             else if (stab_lastexpr(stab) == exprnum)
  1295.                 return 1;
  1296.             continue;
  1297.             }
  1298.             else if (*s == '\\' && s[1])
  1299.             s++;
  1300.             s++;
  1301.         }
  1302.         }
  1303.         break;
  1304.     case A_SPAT:
  1305.         if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
  1306.         return 1;
  1307.         break;
  1308.     case A_READ:
  1309.     case A_INDREAD:
  1310.     case A_GLOB:
  1311.     case A_WORD:
  1312.     case A_SINGLE:
  1313.         break;
  1314.     }
  1315.     }
  1316.     switch (arg->arg_type) {
  1317.     case O_ARRAY:
  1318.     case O_LARRAY:
  1319.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1320.         (void)aadd(arg[1].arg_ptr.arg_stab);
  1321.     break;
  1322.     case O_HASH:
  1323.     case O_LHASH:
  1324.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1325.         (void)hadd(arg[1].arg_ptr.arg_stab);
  1326.     break;
  1327.     case O_EVAL:
  1328.     case O_SUBR:
  1329.     case O_DBSUBR:
  1330.     return 1;
  1331.     }
  1332.     return 0;
  1333. }
  1334.  
  1335.  
  1336. static int
  1337. spat_common(spat,exprnum,marking)
  1338. register SPAT *spat;
  1339. int exprnum;
  1340. int marking;
  1341. {
  1342.     if (spat->spat_runtime)
  1343.     if (arg_common(spat->spat_runtime,exprnum,marking))
  1344.         return 1;
  1345.     if (spat->spat_repl) {
  1346.     if (arg_common(spat->spat_repl,exprnum,marking))
  1347.         return 1;
  1348.     }
  1349.     return 0;
  1350. }
  1351.